home *** CD-ROM | disk | FTP | other *** search
/ Aminet 5 / Aminet 5 - March 1995.iso / Aminet / text / misc / pcal_4_5.lha / pcal / pcalinit.ps < prev    next >
Text File  |  1994-10-16  |  25KB  |  965 lines
  1. % pcalinit.ps - provides the PostScript routines for pcal.c
  2. %
  3. % 4.5    modified by Andrew Rogers:
  4. %
  5. %    support dummy ps_noXXXX for most ps_XXXX's (cf. writefil.c)
  6. %
  7. %    use "bind" wherever possible to force replacement of operator names
  8. %    by operators
  9. %
  10. %    surround optional PostScript boilerplate by #BEGIN..#END blocks (cf.
  11. %    pcalinit.c, writefil.c) to minimize size of PostScript output file
  12. %
  13. %    pre-scale all fonts to be used in printing any given calendar (cf.
  14. %    writefil.c)
  15. %
  16. %    moved date width calculation from holidaytext{} to drawnums{} (to
  17. %    minimize superfluous font loading and scaling)
  18. %
  19. %    moved date color calculation from drawnums{} to print_colors() in
  20. %    writefil.c; split drawnums{} into separate loops for small calendars
  21. %    (all black) and medium/large calendars (mixed colors)
  22. %
  23. %    add support for RGB values in addition to gray levels in dates
  24. %    and fill boxes (cf. writefil.c); split prtday{} into B&W and
  25. %    color versions accordingly
  26. %
  27. %    document all PostScript function definitions
  28. %
  29. %    parameterize additional font and margin sizes
  30. %
  31. %    move definition of colors and sizes to writefil.c (q.v.)
  32. %
  33. %    draw outermost grid box using 'closepath' (correct line merging at
  34. %    corners); increase grid width when printing small/medium calendars
  35. %
  36. %    check for duplex mode support and disable it if present
  37. %
  38. %    select right margin in holidaytext more carefully (avoid overflow
  39. %    into next box)
  40. %
  41. %    use 'weekdayfont' for drawing weekday names
  42. %
  43. % 4.4    modified by Andrew Rogers:
  44. %
  45. %    support greater flexibility in specification of date colors
  46. %
  47. %    support "-[dt]<font>/<size>" options (single-month calendars only);
  48. %    rewrite code for positioning dates, text, etc. in terms of date
  49. %    font size and move font size initialization to Pcal proper
  50. %
  51. %    move fonts for note box heading, weekday names, foot strings to Pcal
  52. %
  53. % 4.3    modified by Andrew Rogers:
  54. %
  55. %    removed definitions of dategray and fillgray; handled instead by
  56. %    Pcal itself (may be selected by user via -s flag)
  57. %
  58. %    enlarge dates in small and medium calendars; enlarge title and
  59. %    weekday names in medium calendars
  60. %
  61. % 4.2    modified by Andrew Rogers:
  62. %
  63. %    support -[kK] options to reposition small calendars
  64. %
  65. %    use same font size for "Notes" as for weekday names; delete heading
  66. %    from notes box if null
  67. %
  68. %    move definition of notesfontsize to Pcal proper; tweak some of the
  69. %    routines to take variable font size into account
  70. %
  71. %    add support for printing notes in any blank box on calendar and
  72. %    suppressing small calendars
  73. %
  74. % 4.1    modified by Andrew Rogers:
  75. %
  76. %    support -G option (cf. prtday) to print "gray" dates as filled
  77. %    outlines
  78. %
  79. % 4.0    modified by Andrew Rogers:
  80. %
  81. %    support -w ("whole year") option - cf. printmonth_[pl], startpage
  82. %    moved all the calendar calculations to pcal.c and moonphas.c (q.v.)
  83. %
  84. %    support -B option (leave unused boxes blank)
  85. %
  86. %    support -O option (print "gray" numbers as outlines)
  87. %
  88. %    revised several of the basic routines and added some others; dates,
  89. %    moons, text, Julian days are now relative to upper-left corner of box
  90. %
  91. %    enlarged title and dates in small calendars
  92. %
  93.  
  94. /Y0 35 def                % Y-coordinate of calendar grid origin
  95.  
  96. /daywidth 100 def            % dimensions of grid boxes
  97. /dayheight 80 def
  98. /gridwidth daywidth 7 mul def
  99. /gridheight dayheight 6 mul def
  100. /negdaywidth daywidth neg def
  101. /negdayheight dayheight neg def
  102. /neggridwidth gridwidth neg def
  103. /neggridheight gridheight neg def
  104.  
  105. /textmargin 2 def            % left/right margin for text
  106. /notemargin 4 def            % left/right margin for notes
  107. /charlinewidth 0.1 def            % width of outline characters
  108.  
  109. /datewidth 2 array def            % for aligning holiday text
  110.  
  111. /moonlinewidth 0.1 def            % width of moon icon line
  112. /radius 6 def                % radius of moon icon
  113. /halfperiod 0.5 def            % scale factors, etc. used by "domoon"
  114. /quartperiod 0.25 def
  115. /offset radius datemargin 0 get add def
  116. /rect radius 2 sqrt mul quartperiod div def
  117.  
  118. /hangingindent (   ) def        % for indenting continued text lines
  119.  
  120. statusdict (duplexmode) known {        % disable duplex mode (if supported)
  121.     statusdict begin false setduplexmode end
  122. } if
  123.  
  124. %
  125. % Utility functions:
  126. %
  127.  
  128. % <fontposition> FontSet => --
  129. %
  130. % set current font to element <fontposition> of "allfonts" array
  131. %
  132. /FontSet {
  133.     allfonts exch
  134.     userdict /CurrentFontSet 2 index put
  135.     get setfont
  136. } bind def
  137.  
  138. % <size> *FontSet => --
  139. %
  140. % fetch pre-scaled font (of desired calendar size) from "allfonts" array
  141. %
  142. /TitleFontSet {TF add FontSet} bind def
  143.  
  144. /DateFontSet {DF add FontSet} bind def
  145.  
  146. % -- *FontSet => --
  147. %
  148. % fetch pre-scaled font (of constant size) from "allfonts" array
  149. %
  150. /WeekdayFontSet {WF FontSet} bind def
  151.  
  152. /FootFontSet {FF FontSet} bind def
  153.  
  154. /NotesFontSet {NF FontSet} bind def
  155.  
  156. /HeadingFontSet {HF FontSet} bind def
  157.  
  158. % <string> <width> center => --
  159. %
  160. % display <string> centered horizontally in <width>
  161. %
  162. /center {
  163.     1 index stringwidth pop sub 2 div 0 rmoveto show
  164. } bind def
  165.  
  166.  
  167. % <str1> <str2> strcat => <string>
  168. %
  169. % concatenate <str1> and <str2>; push result onto stack
  170. %
  171. /strcat {
  172.     2 copy
  173.     length exch length
  174.     dup 3 -1 roll add
  175.     string
  176.     dup 0 6 -1 roll putinterval
  177.     dup 3 -1 roll 4 -1 roll putinterval
  178. } bind def
  179.  
  180.  
  181. % prtday => --
  182. %
  183. % pcal will generate the appropriate flavor (B&W or color) of prtday{}
  184. % depending on the shading values (gray scale or red/green/blue) specified
  185. % by the "-s" flag
  186. %
  187.  
  188. #BEGIN    ps_prtday_bw
  189.  
  190. % print "day" in "color" (black, gray, outline, or outline-gray; cf. pcaldefs.h)
  191. % using single value in "dategray" as gray shade
  192. %
  193. /prtday {                    % black and white version
  194.     gsave
  195.     day 3 string cvs            % convert day to string
  196.     [
  197.         { show }                % black (0)
  198.         { dategray 0 get setgray show }        % gray (1)
  199.         { true charpath stroke }        % outline (2)
  200.         { true charpath gsave            % outline-gray (3)
  201.           dategray 0 get setgray fill
  202.           grestore stroke }
  203.     ] color get exec            % execute operators for color
  204.     grestore
  205. } bind def
  206.  
  207. #END
  208.  
  209. #BEGIN    ps_prtday_rgb
  210.  
  211. % print "day" in "color" (black, gray, outline, or outline-gray; cf. pcaldefs.h)
  212. % using three values in "dategray" as red/green/blue levels; "gray" will
  213. % print as solid color, "outline" as color outline; "outline-gray" as black
  214. % outline filled with color
  215. %
  216. /prtday {                    % color version
  217.     gsave
  218.     day 3 string cvs            % convert day to string
  219.     [
  220.         { show }                % black (0)
  221.         { dategray aload pop setrgbcolor show }    % gray (1)
  222.         { dategray aload pop setrgbcolor    % outline (2)
  223.           true charpath stroke }
  224.         { true charpath gsave            % outline-gray (3)
  225.           dategray aload pop setrgbcolor
  226.           fill grestore stroke }
  227.     ] color get exec            % execute operators for color
  228.     grestore
  229. } bind def
  230.  
  231. #END
  232.  
  233.  
  234. % -- nextbox => --
  235. %
  236. % move to same relative position within following day's box
  237. %
  238. /nextbox {
  239.     day startbox add 7 mod 0 eq            % end of week?
  240.         { neggridwidth daywidth add negdayheight rmoveto }  % next row
  241.         { daywidth 0 rmoveto }                    % next col
  242.     ifelse
  243. } bind def
  244.  
  245.  
  246. % <box> boxpos => <x> <y>
  247. %
  248. % calculate and push coordinates of upper-left corner of <box> (0..41)
  249. %
  250. /boxpos {
  251.     dup 7 mod daywidth mul                    % x-coord
  252.     exch 7 idiv negdayheight mul Y0 add            % y-coord
  253. } bind def
  254.  
  255.  
  256. % <day> datepos => <x> <y>
  257. %
  258. % calculate and push coordinates of upper-left corner of box for <day>
  259. %
  260. /datepos {
  261.     startbox add 1 sub dup 7 mod daywidth mul        % x-coord
  262.     exch 7 idiv negdayheight mul Y0 add            % y-coord
  263. } bind def
  264.     
  265.  
  266. %
  267. % Functions for drawing components of calendar:
  268. %
  269. % The point size of a PostScript font includes the descenders on [gjpqy],
  270. % but the Y-origin for printing text starts above any descenders (at the
  271. % bottom of the upper-case characters).  The following code - and other
  272. % code concerned with vertical spacing - assumes that the descenders
  273. % occupy 1/4 of the overall point size.
  274.  
  275.  
  276. % -- drawtitle => --
  277. %
  278. % print month/year title centered at top of calendar
  279. %
  280. /drawtitle {
  281.     /fontsize titlefontsize calsize get def
  282.     calsize TitleFontSet
  283.     /month_name month_names month 1 sub get def
  284.     /yearstring year 10 string cvs def
  285.     0 Y0 fontsize 0.25 mul add
  286.       calsize small eq { 4 } { weekdayfontsize } ifelse
  287.       1.15 mul add moveto
  288.     month_name (  ) strcat yearstring strcat gridwidth center
  289. } bind def
  290.  
  291.  
  292. % -- drawdaynames => --
  293. %
  294. % print weekday names centered above respective columns
  295. %
  296. /drawdaynames {    
  297.     WeekdayFontSet
  298.     0 1 6 {
  299.         /i exch def
  300.         i daywidth mul Y0 weekdayfontsize 0.4 mul add moveto
  301.         day_names i get
  302.         daywidth center
  303.     } for
  304. } bind def
  305.  
  306.  
  307. % -- drawgrid => --
  308. %
  309. % draw the grid (6 rows x 7 columns) for the calendar
  310. %
  311. /drawgrid {
  312.     gridlinewidth calsize get setlinewidth
  313.  
  314.     1 1 6 {                    % inner vertical lines
  315.         daywidth mul Y0 moveto
  316.         0 neggridheight rlineto
  317.         stroke
  318.     } for
  319.  
  320.     1 1 5 {                    % inner horizontal lines
  321.         0 exch negdayheight mul Y0 add moveto
  322.         gridwidth 0 rlineto
  323.         stroke
  324.     } for
  325.  
  326.     newpath                    % border (w/mitered corners)
  327.     0 Y0 moveto
  328.     gridwidth 0 rlineto
  329.     0 neggridheight rlineto
  330.     neggridwidth 0 rlineto
  331.     closepath
  332.     stroke
  333. } bind def
  334.  
  335.  
  336. % -- drawnums => --
  337. %
  338. % print dates in appropriate boxes of calendar
  339. %
  340. /drawnums {
  341.     /fontsize datefontsize calsize get def
  342.     /margin datemargin calsize get def
  343.     calsize DateFontSet
  344.     charlinewidth setlinewidth
  345.     1 datepos fontsize 0.75 mul margin add sub exch margin add exch moveto
  346.  
  347.     % calculate date widths for "holidaytext" to use; use "2" for all
  348.     % single-digit dates and "22" for all double-digit dates
  349.     calsize large eq {
  350.         datewidth 0 (2) stringwidth pop margin 2 mul add put
  351.         datewidth 1 (22) stringwidth pop margin 2 mul add put
  352.     } if
  353.  
  354.     calsize small eq {
  355.         /color 0 def        % small calendar dates (all black)
  356.         1 1 ndays {
  357.             /day exch def
  358.             prtday
  359.             nextbox
  360.         } for
  361.     } {
  362.         1 1 ndays {        % medium/large calendar dates
  363.             /day exch def
  364.             /color date_color day get def
  365.             prtday
  366.             nextbox
  367.         } for
  368.     } ifelse
  369. } bind def
  370.  
  371.  
  372. #BEGIN    ps_julians        % code for printing Julian dates
  373.  
  374. % -- drawjnums => --
  375. %
  376. % print day-of-year (and, optionally, days remaining) for each date
  377. %
  378. /drawjnums {
  379.     NotesFontSet
  380.     1 datepos dayheight 3 sub sub exch daywidth 3 sub add exch moveto
  381.  
  382.     1 1 ndays {
  383.         /day exch def
  384.         /jday jdstart day add 1 sub def
  385.         /str jday 3 string cvs def
  386.         julian-dates true eq {        % print days left in year?
  387.             /str str ( \050) strcat yearlen jday sub 3 string cvs
  388.                 strcat (\051) strcat def
  389.         } if
  390.         gsave
  391.         str dup stringwidth pop 0 exch sub 0 rmoveto show
  392.         grestore
  393.         nextbox
  394.     } for
  395. } bind def
  396.  
  397. #END
  398.  
  399. #BEGIN    ps_nojulians        % dummy version of above (no julian dates)
  400. /drawjnums {} bind def
  401. #END
  402.  
  403.  
  404. #BEGIN    ps_fill            % code for filling blank boxes
  405.  
  406. % <first> <last> fillboxes => --
  407. %
  408. % fill empty calendar boxes in range <first>..<last> (0..41)
  409. %
  410. /fillboxes {
  411.     /last exch def
  412.     /first exch def
  413.  
  414.     first 1 last {        % loop through range of boxes
  415.         /box exch def
  416.         /fillit true def
  417.         calsize large eq {    % skip note and small calendar boxes
  418.             noteboxes { box eq { /fillit false def } if } forall
  419.             box prev_small_cal eq box next_small_cal eq or {
  420.                 /fillit false def
  421.             } if
  422.         } if
  423.         fillit {        % move to position and fill the box
  424.             box boxpos moveto
  425.             gsave
  426.             fillgray aload length 3 eq
  427.                 {setrgbcolor} {setgray} ifelse
  428.             daywidth 0 rlineto
  429.             0 negdayheight rlineto
  430.             negdaywidth 0 rlineto
  431.             closepath fill
  432.             grestore
  433.         } if
  434.     } for
  435. } bind def
  436.  
  437.  
  438. % -- drawfill => --
  439. %
  440. % fill in unused boxes before and after calendar dates
  441. %
  442. /drawfill {
  443.     0 startbox 1 sub fillboxes        % fill boxes before calendar
  444.     startbox ndays add 41 fillboxes        % fill boxes after calendar
  445. } bind def
  446.  
  447. #END
  448.  
  449. #BEGIN    ps_nofill        % dummy version of above (no box fill)
  450. /drawfill {} bind def
  451. #END
  452.  
  453.  
  454. #BEGIN    ps_footer        % code for printing foot strings
  455.  
  456. % -- footstrings => --
  457. %
  458. % print foot strings ([LCR]footstring) at bottom of page
  459. %
  460. /footstrings {
  461.     FootFontSet
  462.     /bottomrow { neggridheight 20 add } bind def
  463.     0 bottomrow moveto
  464.     Lfootstring show
  465.     gridwidth Rfootstring stringwidth pop sub bottomrow moveto
  466.     Rfootstring show
  467.     0 bottomrow moveto
  468.     Cfootstring gridwidth center
  469. } bind def
  470.  
  471. #END
  472.  
  473. #BEGIN    ps_nofooter        % dummy version of above (no foot strings)
  474. /footstrings {} bind def
  475. #END
  476.  
  477.  
  478. #BEGIN    ps_text            % code for printing text within boxes
  479.  
  480. %
  481. % Functions for printing text inside boxes:
  482. %
  483.  
  484. % <day> <text> daytext => --
  485. %
  486. % print <text> in <day> box (below date)
  487. %
  488. /daytext {
  489.     /mytext exch def /day exch def
  490.     NotesFontSet
  491.     day datepos datefontsize large get 0.75 mul datemargin large get
  492.       2 mul add notesfontsize 0.75 mul add sub dup
  493.       /ypos exch def exch textmargin add exch moveto
  494.     currentpoint pop /LM exch def
  495.     /RM LM daywidth textmargin 2 mul sub add def
  496.     showtext
  497. } bind def
  498.     
  499.  
  500. % <day> <text> holidaytext => --
  501. %
  502. % print <text> in <day> box (to right of date)
  503. %
  504. /holidaytext {
  505.     /mytext exch def /day exch def
  506.  
  507.     /datesize datefontsize large get def 
  508.     /margin datemargin large get def
  509.     /dwidth datewidth day 10 lt { 0 } { 1 } ifelse get def
  510.  
  511.     % display the text between the date and the moon icon (if any)
  512.     NotesFontSet
  513.     day datepos margin notesfontsize 0.75 mul add sub dup
  514.     /ypos exch def exch dwidth add exch moveto
  515.     currentpoint pop /LM exch def
  516.     /mwidth do-moon-p {offset radius add} {0} ifelse def    % moon width
  517.     /RM LM daywidth textmargin sub dwidth mwidth add sub add def
  518.     showtext
  519. } bind def
  520.  
  521.  
  522. % <box> <text> notetext => --
  523. %
  524. % print notes heading (if any) and <text> in <box> (0..41)
  525. %
  526. /notetext {
  527.     /mytext exch def /box exch def
  528.  
  529.     % skip notes box heading if null
  530.     notesheading () eq {
  531.         box boxpos notemargin notesfontsize 0.75 mul add sub dup
  532.     } {
  533.         box boxpos notemargin headingfontsize 0.75 mul add sub exch
  534.           notemargin add exch moveto
  535.         HeadingFontSet
  536.         notesheading show
  537.         box boxpos notemargin headingfontsize add
  538.           notesfontsize add sub dup
  539.     } ifelse
  540.     /ypos exch def exch notemargin add exch moveto
  541.  
  542.     % display the notes text
  543.     NotesFontSet
  544.     /LM currentpoint pop def
  545.     /RM LM daywidth notemargin 2 mul sub add def
  546.     showtext
  547. } bind def
  548.  
  549.  
  550. % -- crlf => --
  551. %
  552. % simulate carriage return/line feed sequence
  553. %
  554. /crlf {
  555.     ypos notesfontsize sub /ypos exch def LM ypos moveto
  556. } bind def
  557.  
  558.  
  559. % <string> prstr => --
  560. %
  561. % print <string> on current line if possible; otherwise print on next line
  562. %
  563. /prstr {
  564.     dup stringwidth pop currentpoint pop
  565.     add RM gt { crlf hangingindent show } if show
  566. } bind def
  567.  
  568.  
  569. % -- showtext => --
  570. %
  571. % print words in "mytext", inserting line breaks where necessary (or requested)
  572. %
  573. /showtext {
  574.     mytext {
  575.         dup linesep eq            % force new line?
  576.             { crlf pop }        % yes - discard text
  577.             { prstr ( ) show }    % no - print string + space
  578.         ifelse
  579.     } forall
  580. } bind def
  581.  
  582. #END
  583.  
  584. #BEGIN ps_notext        % dummy version of above (if no text)
  585.                 % (for future use)
  586. #END
  587.  
  588. %
  589. % Functions for printing months of various sizes and orientations:
  590. %
  591.  
  592.  
  593. % -- startpage => --
  594. %
  595. % initialize new physical page
  596. %
  597. /startpage {
  598.     rval rotate
  599.     xsval ysval scale
  600.     xtval ytval translate
  601. } bind def
  602.  
  603.  
  604. % -- calendar => --
  605. %
  606. % draw calendar for "month"/"year", with various features enabled/disabled
  607. % according to "calsize"
  608. %
  609. /calendar {
  610.     drawtitle                    % month/year
  611.     calsize small ne { drawdaynames } if        % weekday names
  612.     calsize large eq { footstrings } if        % footer strings
  613.     drawnums                    % dates
  614.     calsize large eq                % Julian dates
  615.       julian-dates false ne and { drawjnums } if
  616.     fill-boxes { drawfill } if            % fill boxes
  617.     drawgrid                    % grid
  618.     calsize large eq                % moon icons
  619.       draw-moons false ne and { drawmoons } if   
  620.     0 0 moveto
  621. } bind def
  622.  
  623.  
  624. % -- printmonth => --
  625. %
  626. % print calendar at specified position ("posn": 0..11) on landscape or
  627. % portrait page
  628. %
  629.  
  630. #BEGIN    ps_year_l        % code for whole-year calendars (landscape)
  631.  
  632. /printmonth {
  633.     /calsize medium def
  634.  
  635.     posn 0 eq {        % assume first month printed on page is posn 0
  636.         startpage
  637.         footstrings
  638.     } if
  639.  
  640.     gsave            % draw medium calendar at selected position
  641.     .226 .25 scale        % landscape mode - 3 rows, 4 cols
  642.     posn 4 mod 800 mul
  643.     posn 4 idiv -700 mul 150 add
  644.     translate
  645.     calendar
  646.     grestore
  647. } bind def
  648.  
  649. #END
  650.  
  651.  
  652. #BEGIN    ps_year_p        % code for whole-year calendars (portrait)
  653.  
  654. /printmonth {    
  655.     /calsize medium def
  656.  
  657.     posn 0 eq {        % assume first month printed on page is posn 0
  658.         gsave        % print foot strings at original scale
  659.         startpage
  660.         0 20 translate  % move foot strings up slightly 
  661.         footstrings
  662.         grestore    % re-scale Y axis for portrait mode
  663.  
  664.         /sv_ysval ysval def
  665.         /ysval ysval 1.675 mul def
  666.         startpage
  667.         /ysval sv_ysval def
  668.     } if
  669.  
  670.     gsave            % draw medium calendar at selected position
  671.     .304 .194 scale        % portrait mode - 4 rows, 3 cols
  672.     posn 3 mod 800 mul
  673.     posn 3 idiv -700 mul 300 add
  674.     translate
  675.     calendar
  676.     grestore
  677. } bind def
  678.  
  679. #END
  680.  
  681.  
  682. #BEGIN    ps_month        % code for single-month calendars
  683.  
  684. % -- printmonth => --
  685. %
  686. % print full-size calendar for "month"/"year" on single page
  687. %
  688. /printmonth {
  689.     /calsize large def
  690.     startpage
  691.     calendar
  692.     printsmallcals                % small calendars
  693.     
  694. } bind def
  695.  
  696.  
  697. % -- printsmallcals => --
  698. %
  699. % print small calendars in boxes "prev_small_cal" and "next_small_call"
  700. %
  701. /printsmallcals {
  702.     /calsize small def
  703.     /sv_startbox startbox def
  704.  
  705.     prev_small_cal 0 ge {            % previous month/year
  706.         /year p_year def
  707.         /month p_month def
  708.         /startbox p_startbox def
  709.         /ndays p_ndays def
  710.         gsave
  711.         prev_small_cal boxpos translate
  712.         .138 .138 scale
  713.         12 -120 translate
  714.         calendar
  715.         grestore
  716.     } if
  717.  
  718.     next_small_cal 0 ge {            % next month/year
  719.         /year n_year def
  720.         /month n_month def
  721.         /startbox n_startbox def
  722.         /ndays n_ndays def
  723.         gsave
  724.         next_small_cal boxpos translate
  725.         .138 .138 scale
  726.         12 -120 translate
  727.         calendar
  728.         grestore
  729.     } if
  730.  
  731.     /startbox sv_startbox def        % required for text boxes
  732. } bind def
  733.  
  734. #END
  735.  
  736.  
  737. #BEGIN    ps_moons        % code for drawing moon icons
  738.  
  739. %
  740. % Moon drawing functions:
  741. %
  742.  
  743.  
  744. % <phase> domoon => --
  745. %
  746. % draw icon showing moon at <phase> (0 = new; .25 = fq; .5 = full; .75 = lq)
  747. %
  748. /domoon {
  749.     /phase exch def
  750.  
  751.     gsave
  752.     currentpoint translate
  753.     newpath
  754.  
  755.     % if moon is full, just draw unfilled circle
  756.  
  757.     phase halfperiod .01 sub ge phase halfperiod .01 add le and {
  758.         0 0 radius
  759.         0 360 arc stroke
  760.     }
  761.     {
  762.         % draw the line arc now; prepare (but don't draw) the fill arc
  763.  
  764.         0 0 radius            % for line and fill arcs
  765.         0 0 radius 
  766.         phase halfperiod lt {        % phase between new and full
  767.             270 90 arc stroke    % (line on right, fill on left)
  768.             0 radius neg moveto
  769.             270 90 arcn 
  770.         }
  771.         {                % phase between full and new
  772.             90 270 arc stroke    % (line on left, fill on right)
  773.             0 radius neg moveto
  774.             270 90 arc 
  775.             /phase phase halfperiod sub def
  776.         } ifelse
  777.  
  778.         % curveto uses (x0,y0) (current point), (x1,y1), (x2,y2),
  779.         % and (x3,y3) as the control points for drawing a Bezier
  780.         % cubic section, used here as the curve dividing the moon
  781.         % icon into dark and light sections.  x1 is in the range
  782.         % -R*sqrt(2) <= x1 <= R*sqrt(2) and y1 is in the range
  783.         % 0 <= y1 <= R; note that except in the degenerate case
  784.         % where x1 = y1 = x2 = y2 = 0, the curve does not actually
  785.         % pass through (x1,y1) or (x2,y2).
  786.  
  787.         /x1 quartperiod phase sub rect mul def
  788.         /y1 x1 abs 2 sqrt div def
  789.  
  790.         % push control points for curveto
  791.  
  792.                     % x0 = 0   (current
  793.                     % y0 = R    point)
  794.         x1            % x1
  795.         y1            % y1
  796.         x1            % x2 = x1
  797.         y1 neg            % y2 = -y1
  798.         0            % x3 = 0
  799.         radius neg        % y3 = -R
  800.  
  801.         % draw Bezier curve; fill area between curve and fill arc
  802.  
  803.         curveto
  804.         fill
  805.     } ifelse
  806.  
  807.     grestore
  808. } bind def
  809.  
  810.  
  811. % -- do-moon-p => <bool>
  812. %
  813. % determine whether or not moon icon is to be drawn on "day"; push result
  814. %
  815. /do-moon-p {
  816.     draw-moons (some) eq {        % printing quarter moons?  look up day
  817.         /p false def
  818.         quarter_moons { day eq { /p true def } if } forall
  819.         p
  820.     }
  821.     {
  822.         draw-moons        % all moons or no moons
  823.     } ifelse
  824. } bind def
  825.  
  826.  
  827. % -- drawmoons => --
  828. %
  829. % main routine to draw moon icons on calendar
  830. %
  831. /drawmoons {
  832.     gsave
  833.     moonlinewidth setlinewidth
  834.     1 datepos offset sub exch daywidth add offset sub exch moveto
  835.     /n 0 def            % index into moon_phases
  836.     1 1 ndays {
  837.         /day exch def
  838.         do-moon-p {        % draw a moon today?
  839.             moon_phases n get domoon
  840.             /n n 1 add def
  841.         } if
  842.         nextbox
  843.     } for
  844.     grestore
  845. } bind def
  846.  
  847. #END
  848.  
  849. #BEGIN    ps_nomoons        % dummy version of above (no moons)
  850. /do-moon-p { false } bind def
  851. /drawmoons {} bind def
  852. #END
  853.  
  854. #BEGIN    ps_roman8
  855.  
  856. %
  857. % Roman8 character mappings
  858. %
  859. /alt_mappings [                         %% Roman8 character mappings
  860. 8#241 /Agrave           8#242 /Acircumflex      8#243 /Egrave           8#244 /Ecircumflex
  861. 8#245 /Edieresis        8#246 /Icircumflex      8#247 /Idieresis        8#250 /acute
  862. 8#251 /grave            8#252 /circumflex       8#253 /dieresis         8#254 /tilde
  863. 8#255 /Ugrave           8#256 /Ucircumflex      8#257 /sterling         8#260 /macron
  864. 8#261 /Yacute           8#262 /yacute           8#263 /degree           8#264 /Ccedilla
  865. 8#265 /ccedilla         8#266 /Ntilde           8#267 /ntilde           8#270 /exclamdown
  866. 8#271 /questiondown     8#272 /currency         8#273 /sterling         8#274 /yen
  867. 8#275 /section          8#276 /florin           8#277 /cent             8#300 /acircumflex
  868. 8#301 /ecircumflex      8#302 /ocircumflex      8#303 /ucircumflex      8#304 /aacute
  869. 8#305 /eacute           8#306 /oacute           8#307 /uacute           8#310 /agrave
  870. 8#311 /egrave           8#312 /ograve           8#313 /ugrave           8#314 /adieresis
  871. 8#315 /edieresis        8#316 /odieresis        8#317 /udieresis        8#320 /Aring
  872. 8#321 /icircumflex      8#322 /Oslash           8#323 /AE               8#324 /aring
  873. 8#325 /iacute           8#326 /oslash           8#327 /ae               8#330 /Adieresis
  874. 8#331 /igrave           8#332 /Odieresis        8#333 /Udieresis        8#334 /Eacute
  875. 8#335 /idieresis        8#336 /germandbls       8#337 /Ocircumflex      8#340 /Aacute
  876. 8#341 /Atilde           8#342 /atilde           8#343 /Eth              8#344 /eth
  877. 8#345 /Iacute           8#346 /Igrave           8#347 /Oacute           8#350 /Ograve
  878. 8#351 /Otilde           8#352 /otilde           8#353 /Scaron           8#354 /scaron
  879. 8#355 /Uacute           8#356 /Ydieresis        8#357 /ydieresis        8#360 /thorn
  880. 8#361 /Thorn            8#362 /dotaccent        8#363 /mu               8#364 /paragraph
  881. 8#365 /threequarters    8#366 /hyphen           8#367 /onequarter       8#370 /onehalf
  882. 8#371 /ordfeminine      8#372 /ordmasculine     8#373 /guillemotleft    8#374 /bullet
  883. 8#375 /guillemotright   8#376 /plusminus        8#377 /.notdef
  884. ] def
  885.  
  886. #END
  887.  
  888. #BEGIN    ps_latin1
  889.  
  890. %
  891. % ISO Latin1 character mappings
  892. %
  893. /alt_mappings [                         %% ISO Latin1 character mappings
  894. 8#221 /grave            8#222 /acute            8#223 /circumflex       8#224 /tilde
  895. 8#225 /macron           8#226 /breve            8#227 /dotaccent        8#230 /dieresis
  896. 8#231 /.notdef          8#232 /ring             8#233 /cedilla          8#234 /.notdef
  897. 8#235 /hungarumlaut     8#236 /ogonek           8#237 /caron            8#240 /space
  898. 8#241 /exclamdown       8#242 /cent             8#243 /sterling         8#244 /currency
  899. 8#245 /yen              8#246 /brokenbar        8#247 /section          8#250 /dieresis
  900. 8#251 /copyright        8#252 /ordfeminine      8#253 /guillemotleft    8#254 /logicalnot
  901. 8#255 /hyphen           8#256 /registered       8#257 /macron           8#260 /degree
  902. 8#261 /plusminus        8#262 /twosuperior      8#263 /threesuperior    8#264 /acute
  903. 8#265 /mu               8#266 /paragraph        8#267 /periodcentered   8#270 /cedilla
  904. 8#271 /onesuperior      8#272 /ordmasculine     8#273 /guillemotright   8#274 /onequarter
  905. 8#275 /onehalf          8#276 /threequarters    8#277 /questiondown     8#300 /Agrave
  906. 8#301 /Aacute           8#302 /Acircumflex      8#303 /Atilde           8#304 /Adieresis
  907. 8#305 /Aring            8#306 /AE               8#307 /Ccedilla         8#310 /Egrave
  908. 8#311 /Eacute           8#312 /Ecircumflex      8#313 /Edieresis        8#314 /Igrave
  909. 8#315 /Iacute           8#316 /Icircumflex      8#317 /Idieresis        8#320 /Eth
  910. 8#321 /Ntilde           8#322 /Ograve           8#323 /Oacute           8#324 /Ocircumflex
  911. 8#325 /Otilde           8#326 /Odieresis        8#327 /multiply         8#330 /Oslash
  912. 8#331 /Ugrave           8#332 /Uacute           8#333 /Ucircumflex      8#334 /Udieresis
  913. 8#335 /Yacute           8#336 /Thorn            8#337 /germandbls       8#340 /agrave
  914. 8#341 /aacute           8#342 /acircumflex      8#343 /atilde           8#344 /adieresis
  915. 8#345 /aring            8#346 /ae               8#347 /ccedilla         8#350 /egrave
  916. 8#351 /eacute           8#352 /ecircumflex      8#353 /edieresis        8#354 /igrave
  917. 8#355 /iacute           8#356 /icircumflex      8#357 /idieresis        8#360 /eth
  918. 8#361 /ntilde           8#362 /ograve           8#363 /oacute           8#364 /ocircumflex
  919. 8#365 /otilde           8#366 /odieresis        8#367 /divide           8#370 /oslash
  920. 8#371 /ugrave           8#372 /uacute           8#373 /ucircumflex      8#374 /udieresis
  921. 8#375 /yacute           8#376 /thorn            8#377 /ydieresis
  922. ] def
  923.  
  924. #END
  925.  
  926.  
  927. #BEGIN    ps_remap        % create new font incorporating 8-bit character mappings
  928.  
  929. /alt_dict 20 dict def            % Local storage
  930.  
  931. % <oldfont> <newfont> remap_font => --
  932. %
  933. % create remapped font using one of the above 8-bit character remapping tables
  934. %
  935. /remap_font {
  936.     alt_dict begin
  937.         /newName exch def
  938.         /oldName exch def
  939.         /oldDict oldName findfont def
  940.         /newDict oldDict maxlength dict def
  941.         oldDict {
  942.             exch dup /FID ne {
  943.                 dup /Encoding eq {
  944.                     exch dup length array copy
  945.                     newDict 3 1 roll put
  946.                 } {
  947.                     exch newDict 3 1 roll put
  948.                 } ifelse
  949.             } {
  950.                 pop pop
  951.             } ifelse
  952.         } forall
  953.         newDict /FontName newName put
  954.         0 2 alt_mappings length 1 sub {
  955.             dup
  956.             alt_mappings exch get
  957.             exch 1 add alt_mappings exch get
  958.             newDict /Encoding get 3 1 roll put
  959.         } for
  960.         newName newDict definefont pop
  961.     end
  962. } bind def
  963.  
  964. #END
  965.